home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
mapl0301.zip
/
SYSTEM.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-03-01
|
8KB
|
134 lines
' $linesize:132
' $title: 'SYSTEM.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
' Copyright 1991 by D. Thomas Mack, all rights reserved.
' Name ...............: SYSTEM.BAS
' First Released .....: Jan 24, 1993
' Subsequent Releases.: Feb 2, 1993, Feb 25, 1993
' Copyright ..........: 1986 - 1993
' Purpose.............: To move internal text into an external file to free
' up as much string space as possible and to allow
' RBBS to develope into a multi language BBS system
'
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' $SUBTITLE: 'GetRBBSString - Read a string from external file'
' $PAGE (C) 1992 - Mercurio & Sarru
' mods (C) 1993 - Dan Drinnon
' additional mods (C) by Pete Eibl 1993
'
' $INCLUDE: 'RBBS-VAR.MOD'
' SUBPROGRAM NAME -- GetRBBSString
'
'
' SUBPROGRAM PURPOSE -- reduce String space
SUB GetRBBSString (LineToRead,OutText$) STATIC ' DD012202
' ' DD012202
' example: CALL GetRBBSString (50,RBBSString$) ' DD012202
' CALL QuickTPut1 (RBBString$) ' DD012202
' ' DD012202
Call OpenRand (15,ZLibDrive$ +"RBBSPC.LNG",92) 'Pe022501
FIELD 15, 92 AS Stringa$ 'Pe022501
GET 15, LineToRead 'Pe022501
Z = INSTR(Stringa$,"*eol*") 'Pe022501
OutText$ = Left$(stringa$,(Z-1)) 'Pe022501
Stringa$ = ""
Close 15 'Pe022501
CALL SmartText(OutText$,ZTrue,ZFalse,ZFalse) 'Pe022501
END SUB 'Pe022501
' $SUBTITLE: 'ShowVar --- '
' $PAGE
'Sub ShowVar (OutText$) Static
'
' Ignore this code, it is NOT used but may be used in the future
' WasY = 1
' IF WasY > LEN(OutText$) THEN Exit Sub
' WasX = INSTR(WasY, OutText$, "{{")
' IF WasX = 0 THEN Exit Sub
' WasY = INSTR(WasX, OutText$, "}}")
' IF WasY = 0 THEN Exit Sub
' OutText1$ = LEFT$(OutText$, WasX - 1) + Mid$(OutText$, WasY + 2)
' WasY = WasY - WasX
' ShowV$ = MID$(OutText$, WasX + 2, WasY - 2)
'End Sub
'
' MarkTimeB (C) 1993 - Dan Drinnon
'
'
SUB MarkTimeB (DotNumber) STATIC ' DD012602
IF DotNumber = 0 THEN ' DD012602
RANDOMIZE TIMER ' DD020502
Style = INT(RND * 6) + 1 ' DD012602
' ON Style GOSUB 60230,60240,60250,60260,60270,60280 'Pe021493
GOSUB 60280 'Comment this out for Random character generation
CALL QuickTPut (" ",0) ' DD012602
END IF ' DD012602
TimeNow! = TIMER ' DD012602
IF TimeNow! - PrevTI! < 0.15 THEN _ ' DD012602
EXIT SUB ' DD012602
PrevTI! = TimeNow! ' DD012602
DotNumber = DotNumber + 1 ' DD012602
IF DotNumber = 5 THEN DotNumber = 1 ' DD012602
WasX$ = ZBackSpace$ ' DD012602
ON DotNumber GOTO 60201,60202,60203,60204 ' DD012602
60201 WasX$ = WasX$ + ZFG1$ + char1$ ' DD012602
GOTO 60205 ' DD012602
60202 WasX$ = WasX$ + ZFG2$ + char2$ ' DD012602
GOTO 60205 ' DD012602
60203 WasX$ = WasX$ + ZFG3$ + char3$ ' DD012602
GOTO 60205 ' DD012602
60204 WasX$ = WasX$ + ZFG4$ + char4$ ' DD012602
60205 CALL QuickTPut (WasX$ + ZEmphasizeOff$,0) ' DD012602
EXIT SUB ' DD012602
60230 IF ZWasGR = 0 THEN GOTO 60260 ' DD012602
char1$ = CHR$(221) ' DD012602
char2$ = CHR$(220) ' DD012602
char3$ = CHR$(222) ' DD012602
char4$ = CHR$(223) ' DD012602
RETURN ' DD012602
60240 IF ZWasGR = 0 THEN GOTO 60270 ' DD012602
char1$ = CHR$(218) ' DD012602
char2$ = CHR$(191) ' DD012602
char3$ = CHR$(217) ' DD012602
char4$ = CHR$(192) ' DD012602
RETURN ' DD012602
60250 IF ZWasGR = 0 THEN GOTO 60280 ' DD012602
char1$ = CHR$(92) ' DD012602
char2$ = CHR$(124) ' DD012602
char3$ = CHR$(47) ' DD012602
char4$ = CHR$(196) ' DD012602
RETURN ' DD012602
60260 char1$ = CHR$(43) ' DD012602
char2$ = CHR$(42) ' DD012602
char3$ = CHR$(45) ' DD012602
char4$ = CHR$(42) ' DD012602
RETURN ' DD012602
60270 char1$ = CHR$(16) ' DD012602
char2$ = CHR$(30) ' DD012602
char3$ = CHR$(17) ' DD012602
char4$ = CHR$(31) ' DD012602
RETURN ' DD012602
60280 char1$ = CHR$(92) ' DD012602
char2$ = CHR$(124) ' DD012602
char3$ = CHR$(47) ' DD012602
char4$ = CHR$(45) ' DD012602
RETURN ' DD012602
END SUB ' DD012602
'
' Look for the RBBS.LNG file as specified in CONFIG paramter 301
' if NOT found display message and let them wait a real long time
'
SUB FindLang Static
LangFile$ = ZLibDrive$+"\RBBSPC.LNG"
Call Findit (LangFile$)
If NOT ZOK THEN
Call QuickTput (ZCrLf$ + Chr$(7)+" Missing Language file for RBBS , Please tell SYSOP"+Chr$(7),2)
Call QuickTput ( " Messages and Command Prompts are NOT available" ,2)
Call QuickTput ( " System Will Shut down NOW, Please Hang Up ! ....",3)
Call DelayTime (5)
LINE INPUT " Hit a Key to return to DOS...! " ; TEMP$
SYSTEM
End IF
End Sub